-- card: 5393 from stack: in.5 -- bmap block id: 5817 -- flags: 0000 -- background id: 3858 -- name: FolderPath ----- HyperTalk script ----- on HideObjects hide cd btn "Try It!" end HideObjects on ShowObjects show cd btn "Try It!" end ShowObjects -- part 3 (button) -- low flags: 00 -- high flags: A002 -- rect: left=82 top=185 right=219 bottom=175 -- title width / last selected line: 0 -- icon id / first selected line: 0 / 0 -- text alignment: 1 -- font id: 0 -- text size: 12 -- style flags: 8192 -- line height: 16 -- part name: Try it! ----- HyperTalk script ----- on mouseUp global errGlobal put FolderPath("Choose a folder please.") into thePath if thePath = empty then exit mouseUp if errGlobal ≠ empty then answer "Error: “" & errGlobal & "”" put empty into errGlobal else answer "You chose “" & thePath & "”" end if end mouseUp -- part contents for background part 20 ----- text ----- FolderPath displays a modified Standard File dialog to let the user choose a folder. It returns the full path name of the chosen folder, or empty if the CANCEL button is chosen. In addition to the standard Eject, Drive, Select, and Cancel buttons, the XFCN displays the amount of free space on a volume. Additionally you may supply a prompt string (in parameter two) which will be placed below the file list. If called without any parmeters, ie. FolderName(), the default prompt will be used (Highlight a directory and press "Select"). As with all of our XCMDs and XFCNs, passing a single question mark (FolderName("?") in this case) returns the syntax for the external. Passing an exclamation point (FolderName("!")) returns the copyright information. -- part contents for background part 38 ----- text ----- 23/50 -- part contents for background part 42 ----- text ----- { FolderName() XFCN source listing} { This is an XFCN that brings up a custom standard file dialog to allow the user to select a folder.} { This source file is part of a stack containing all necessary source code and compiled versions of} {} { Written by: Anup Murarka Eric Carlson } { ALINK: SKEPTIC ALINK: cyNic } { CIS: 76004,3356 } {} { We are part of the Support Tools Development Group, } { Apple Computer, Inc. } {} { please DO NOT contack Mac DTS for support of this code! } {} { please DO contact the authors for support of this code! } {} { Send comments, bug reports, requests to any of the above } { E-mail addresses or to:} {} { (one of us) } { Apple Computer, Inc. } { 900 E. Hamilton, Ave. } { Campbell, CA 95008 } { M/S 72-L } {} { Copyright: © 1989, 1990 by Apple Computer, Inc., all rights reserved. } {} { written by : Anup Murarka } { AppleLink : Skeptic } { modification history } { Date Initials Comments } { ---- ------ ------------------------------------------------------} { 11/29/89 ec&akm first written } { 8/14/90 ec recompiled with new libraries for Modal Dialog update bug } { & A/UX correct path construction. Changed version to 1.1 } {} unit dummyUnit; interface uses HyperXCMD; procedure main (paramPtr: XCmdPtr); implementation procedure FolderName (paramPtr: XCmdPtr); FORWARD; procedure main (paramPtr: XCmdPtr); begin FolderName(paramPtr); end; const kSFSaveDisk = $214; { Negative of current volume refnum [WORD] } kApplScratch = $00000A78; kCurDirStore = $398; { DirID of current directory [LONG] } DITLSizeDiff = 30; type DITLItem = record itmHndl: handle; itmRect: rect; itmType: SignedByte; itmData: SignedByte; { This is really only the length byte. Data follows of variable length} { itmData is followed by the actual data. See IM I-427} end; pDITLItem = ^DITLItem; hDITLItem = ^pDITLItem; ItemList = record dlgMaxIndex: integer; DITLItems: array[0..0] of DITLItem; end; pItemList = ^ItemList; hItemList = ^pItemList; integerPtr = ^integer; procedure reportToUser (paramPtr: XCmdPtr; msgStr: str255); {} { report something back to the user. } { the last parameter (optional) to an external may contain } { "noDialog" or "noDialog:GlobalName". GlobalName is the name } { of a HyperTalk global variable into which error messages will be } { placed. we've decided to use this approach to avoid confusing } { an error message with a valid result being returned from an XFCN. } {} var tempStr: str255; begin {check the last param to see if the user requested that} { we suppress the error dialog } ZeroToPas(paramPtr, paramPtr^.params[paramPtr^.paramCount]^, tempStr); UprString(tempStr, true); if pos('NODIALOG', tempStr) = 0 then { no special error handling specified, throw up a dialog and return the error message } begin SendCardMessage(paramPtr, concat('answer "', msgStr, '"')); paramPtr^.returnValue := PasToZero(paramPtr, msgStr); end else if (pos(':', tempStr) > 0) then { requested global AND noDialog so we fill in the global and return empty } begin tempStr := copy(tempStr, pos(':', tempStr) + 1, length(tempStr)); { get the name of the HC global to fill } SetGlobal(paramPtr, tempStr, PasToZero(paramPtr, msgStr)); { and fill it } paramPtr^.returnValue := PasToZero(paramPtr, ''); { return empty } end else { requested noDialog only so we return the error condition as the result } paramPtr^.returnValue := PasToZero(paramPtr, msgStr); end; { procedure } function AskedForHelp (paramPtr: XCmdPtr; syntaxMsg: Str255; copyrightMsg: Str255): boolean; { check to see if the user sent a '?' or a '!' as } { the only parameter. if so we will respond with } { the calling syntax or the copyright/version info } { for this external } {} var firstStr: str255; begin askedForHelp := false; if paramPtr^.paramCount = 1 then begin ZeroToPas(paramPtr, paramPtr^.params[1]^, firstStr); { what is the first param? } if firstStr = '?' then begin reportToUser(paramPtr, syntaxMsg); askedForHelp := true end { asked for help } else if firstStr = '!' then begin reportToUser(paramPtr, copyRightMsg); askedForHelp := true end; { asked for copyright info } end; { one parameter passed } end; { function } function PathNameFromDirID (dirID: longint; vRefnum: integer; var fullPathName: str255): OSErr; { build up a full path name given a directory id and an vol ref num. this method isn't reccomended in general (see the } { various tech notes), but we use it in HC externals as HC uses exclusively full path names } var myCPB: CInfoPBRec; directoryName: str255; err: OSErr; begin fullPathName := ''; with myCPB do begin ioNamePtr := @directoryName; ioDrParID := DirId; end; repeat with myCPB do begin ioVRefNum := vRefNum; ioFDirIndex := -1; ioDrDirID := myCPB.ioDrParID; end; err := PBGetCatInfo(@myCPB, FALSE); directoryName := concat(directoryName, ':'); { pascal strings mustn't be longer than 255 chars, though a path name may, so check } if length(directoryName) + length(fullPathName) <= 255 then fullPathName := concat(directoryName, fullPathName) else myCPB.ioDrDirID := fsRtDirID; { lazy persons way to jump out } until (myCPB.ioDrDirID = 2); PathNameFromDirID := err; end; function StrToRect (paramPtr: XCMDPtr; rectStr: Str255): Rect; { convert a string, as from a callback or a passed parameter, to a rect } var where: Integer; tempRect: rect; begin where := POS(',', rectStr); tempRect.left := StrToNum(paramPtr, COPY(rectStr, 1, where - 1)); DELETE(rectStr, 1, where); where := POS(',', rectStr); tempRect.top := StrToNum(paramPtr, COPY(rectStr, 1, where - 1)); DELETE(rectStr, 1, where); where := POS(',', rectStr); tempRect.right := StrToNum(paramPtr, COPY(rectStr, 1, where - 1)); DELETE(rectStr, 1, where); tempRect.bottom := StrToNum(ParamPtr, rectStr); strToRect := tempRect; end; function HCWindowRect (paramPtr: XCMDPtr): rect; { the rect of HC's card window, in GLOBAL coordinates } var theResult: Handle; rectStr: str255; theLength: INTEGER; begin rectStr := 'the rect of card window'; theResult := EvalExpr(paramPtr, rectStr); if (theResult <> nil) and (paramPtr^.result = noErr) then ZeroToPas(paramPtr, theResult^, rectStr) else rectStr := ''; if (theResult <> nil) then DisposHandle(theResult); HCWindowRect := StrToRect(paramPtr, rectStr); end; function GetScreenSize: rect; { we don't have access to quick draw globals, as they lie in HC's global space, but we can } { get the monitor size indirectly by checking the portBits field of the window manager port } { MacRevealed vol 3, pg 20 } var deskPort: GrafPtr; tempRect: rect; begin GetWMgrPort(deskPort); { grab a pointer to the window manager port } if deskPort = nil then begin setRect(tempRect, 0, 0, 512, 342); GetScreenSize := tempRect; end else GetScreenSize := deskPort^.portBits.bounds; end; function monitorRect (aPoint: point): rect; { given a point, return the rect of the monitor that contains it.} const SysEnvVersion = 2; var currGDevice: GDHandle; gotTheMonitor: boolean; tempRect: rect; theSysEnv: SysEnvRec; envErr: OSErr; begin currGDevice := nil; envErr := SysEnvirons(SysEnvVersion, theSysEnv); {SysEnvirons Version is a constant in the interface section of this file} if theSysEnv.hasColorQD then { only proceed if we have color QD } begin currGDevice := GetDeviceList; gotTheMonitor := false; { haven't found the monitor yet } while (currGDevice <> nil) and not (gotTheMonitor) do { we assume that the point is in one of the graphic devices } begin if PtInRect(aPoint, currGDevice^^.gdRect) then begin monitorRect := currGDevice^^.gdRect; gotTheMonitor := true; end else { get the next device in the list } currGDevice := currGDevice^^.gdNextGD; end; if currGDevice = nil then begin setRect(tempRect, 0, 0, 0, 0); monitorRect := tempRect; end; end else {No Color QD} begin tempRect := GetScreenSize; if PtInRect(aPoint, tempRect) then monitorRect := tempRect else begin setRect(tempRect, 0, 0, 0, 0); monitorRect := tempRect; end; end; end; function CenterInHCWindow (paramPtr: XCMDPtr; windowRect: rect): point; var where: point; window, screen, tempRect: rect; h, v: integer; begin window := HCWindowRect(paramPtr); { the rect of card the window } screen := monitorRect(window.topLeft); { check to see the rect of the monitor containing the upper right corner of the card window } setRect(tempRect, 0, 0, 0, 0); if EqualRect(screen, tempRect) then { if '0,0,0,0' comes back then the upper right is off screen, check the upper left } begin setPt(where, window.right, window.top); screen := monitorRect(where); end; OffsetRect(windowRect, window.left - windowRect.left, window.top - windowRect.top); { zero the dlog rect onto the card window } h := ((window.right - window.left) - (windowRect.right - windowRect.left)) div 2; v := ((window.bottom - window.top) - (windowRect.bottom - windowRect.top)) div 2; OffSetRect(windowRect, h, v); { although it isn't possible to have BOTH upper corners off screen, check for an error. } { if we find one, use the default monitor rect } if EqualRect(screen, tempRect) then screen := GetScreenSize; { now center the rect in the card window } if not (PtInRect(windowRect.topLeft, screen) and PtInRect(windowRect.botRight, screen)) then begin { make sure the dlog rect is fully visible on the screen } if windowRect.top < screen.top then OffSetRect(windowRect, 0, screen.top - windowRect.top + 10); if windowRect.bottom > screen.bottom then OffSetRect(windowRect, 0, screen.bottom - windowRect.bottom - 10); if windowRect.left < screen.left then OffSetRect(windowRect, screen.left - windowRect.left + 10, 0); if windowRect.right > screen.right then OffSetRect(windowRect, screen.right - windowRect.right - 10, 0); end; SetPt(where, windowRect.left, windowRect.top); CenterInHCWindow := where; end; function unSignedByte (SB: signedByte): integer; type twoSBAreAnInt = record case integer of 0: ( sbArray: array[0..1] of SignedByte ); 1: ( Int: integer ); end; var tempInt: twoSBAreAnInt; begin tempInt.Int := 0; tempInt.sbArray[1] := SB; unSignedByte := tempInt.int; end; function insertCommas (theNumber: str255): str255; { Procedure to insert commas every 3 numeric digits} var count, group: integer; begin group := 0; for count := length(theNumber) downto 1 do begin group := group + 1; if (group <> 3) or (count = 1) then cycle; insert(',', theNumber, count); group := 0; end; insertCommas := theNumber; end; procedure drawFreeSpace (theDialog: DialogPtr); { draw the amount of free space into the dialog, just above item #5, the eject button } var thePort: GrafPtr; oldFont, oldSize: integer; freeSpace: longint; freeStr: str255; PB: ParamBlockRec; strWidth: integer; volInfoErr: OSerr; eraseArea: rect; itemType, left: integer; itemHndl: handle; itemRect: rect; begin GetPort(thePort); if thePort <> nil then begin PB.iovRefNum := -(integerPtr(kSFSaveDisk)^); { grab the VRefNum directly from lo mem} PB.ioVolIndex := 0; { use vRefNum only } PB.ioNamePtr := @freeStr; { VERY IMPORTANT! Tell PBGetVInfo where to } volInfoErr := PBGetVInfo(@PB, false); { put the vol name, even though we don't use it } if volInfoErr = noErr then begin FreeSpace := (PB.ioVAlBlkSiz * PB.ioVFrBlk) div 1024; { Calc the free size} NumToString(FreeSpace, FreeStr); FreeStr := insertCommas(FreeStr); end else begin FreeStr := '????'; { If an error occured, show question marks} end; FreeStr := concat(FreeStr, 'k free'); oldFont := thePort^.txFont; { remember the old font } oldSize := thePort^.txSize; { and the size } TextFont(3); { set text to geneva } TextSize(9); { 9 point } GetDItem(theDialog, 5, itemType, itemHndl, itemRect); { Get the coordinates of the Eject button} with itemRect do setRect(eraseArea, itemRect.left - 5, itemRect.top - 11, itemRect.right + 5, itemRect.top); eraseRect(eraseArea); strWidth := StringWidth(FreeStr); left := ((itemRect.right - itemRect.left) div 2) + itemRect.left; MoveTo(left - (strWidth div 2), itemRect.top - 2); { move the pen} DrawString(FreeStr); { show em how much free space they have... } TextFont(oldFont); { set font to the original } TextSize(oldSize); { and the size } end; end; function getDirFileFilter (PB: ParamBlockRec): boolean; begin getDirFileFilter := true; { This filter routine filter's out all files so that none are displayed} end; function getDirDlgHook (item: Integer; theDialog: DialogPtr): Integer; procedure AppendDITL (theDialog: DialogPtr); { This routine adds the prompt to the main SFGetFile dialog.} { It also moves the Cancel button down and adds a 'Select' button.} label 10; var hDITL: hDITLItem; { Handle to DITL being appended } hItems: hItemList; { Handle to DLOG’s item list } btnName: Str255; promptHndl: Handle; promptLength: longint; error: OSerr; itemType: integer; itemHndl: handle; itemRect, SelectRect: rect; begin { AppendDITL } BlockMove(POINTER(kApplScratch), @promptHndl, 4); { shift the bottom of the window down for the new item} SetPort(theDialog); with WindowPtr(theDialog)^.portRect do SizeWindow(WindowPtr(theDialog), right - left, bottom - top + DITLSizeDiff, TRUE); { Move Cancel button down. It is not enough just to move it with MoveControl. The Dialog mgr must be } { told it has been moved with a call to "SetDItem" } GetDItem(theDialog, getCancel, itemType, itemHndl, itemRect); SelectRect := itemRect; MoveControl(controlHandle(itemHndl), itemRect.left, itemRect.top + 25); itemRect.top := itemRect.top + 25; itemRect.bottom := itemRect.bottom + 25; SetDItem(theDialog, getCancel, itemType, itemHndl, itemRect); { Now add the 'Select' button to the DITL} btnName := 'Select'; hDITL := hDITLItem(NewHandle(SizeOf(DITLItem) + length(btnName))); if hDITL = nil then exit(AppendDITL); MoveHHI(handle(hDITL)); HLock(handle(hDITL)); { First get the new control} SelectRect.top := SelectRect.top + 2; SelectRect.bottom := SelectRect.bottom + 2; itemHndl := handle(NewControl(theDialog, SelectRect, btnName, true, 0, 0, 1, pushButProc, 0)); if itemHndl = nil then { If we didn't get our memory block, don't make any further changes} goto 10; { Set up a standard button item in the DITL} hDITL^^.itmHndl := itemHndl; hDITL^^.itmRect := SelectRect; hDITL^^.itmType := SignedByte(ctrlItem + btnCtrl); hDITL^^.itmData := SignedByte(length(btnName)); BlockMove(@btnName[1], pointer(ORD4(@hDITL^^.itmData) + 1), length(btnName)); { Now actually copy the item from our data structure onto the end of the DITL in memory for the DLOG} hItems := hItemList(DialogPeek(theDialog)^.items); error := PtrAndHand(pointer(hDITL^), Handle(hItems), sizeOf(DITLItem) + 6); if error <> noErr then sysBeep(10); hLock(handle(hItems)); hItems^^.dlgMaxIndex := hItems^^.dlgMaxIndex + 1; { Save the item number for our button} blockMove(@hItems^^.dlgMaxIndex, pointer(kApplScratch), 2); hUnlock(handle(hItems)); { Add the stat text item for the prompt} HUnlock(Handle(hDITL)); DisposHandle(Handle(hDITL)); { Now create the static text item in memory} promptLength := GetHandleSize(promptHndl); hDITL := hDITLItem(NewHandle(sizeOf(DITLItem) + promptLength)); if hDITL = nil then exit(AppendDITL); { If we don't have enough memory, abort the changes} MoveHHi(handle(hDITL)); HLock(Handle(hDITL)); SetRect(itemRect, 12, 191, 246, 223); { rect for the stat text item } hDITL^^.itmHndl := promptHndl; hDITL^^.itmRect := itemRect; hDITL^^.itmType := SignedByte(statText); hDITL^^.itmData := SignedByte(promptLength); if promptHndl <> nil then begin { Copy our prompt onto the end of the DITLrec} HLock(handle(promptHndl)); blockmove(promptHndl^, pointer(ORD4(@hDITL^^.itmData) + 1), promptLength); { Copy our prompt onto the end of the DITLrec} HUnLock(handle(promptHndl)); end; { Now actually copy the item from our data structure onto the end of the DITL in memory for the DLOG} hItems := hItemList(DialogPeek(theDialog)^.items); error := ptrAndHand(pointer(hDITL^), Handle(hItems), sizeOf(DITLItem) + promptLength); hItems^^.dlgMaxIndex := hItems^^.dlgMaxIndex + 1; 10: HUnlock(Handle(hDITL)); DisposHandle(Handle(hDITL)); end; { AppendDITL } var SelectItem: integer; begin case item of -1: { Called just before the dialog is shown. We add our own items now.} AppendDITL(theDialog); otherwise begin { This is the important one. The item code for our 'Select' button is in SelectItem.} { When it is clicked, we type the event back to a 1 so that standard file will exit.} { The highlighted directory ID is put into reply.fType. reply.vRefNum is filled properly.} { We stored the item number - 1 in ApplScratch, remember?!?} SelectItem := integerPtr(kApplScratch)^ + 1; if item = SelectItem then item := 1; end; end; { Case} getDirDlgHook := item; { Return the item code back to Standard file} end; function getDirDlgFilter (theDialog: DialogPtr; var theEvent: eventRecord; var itemHit: integer): boolean; { Here we handle the different events that occur in the dialog. Mainly it is needed to draw the} { free space string and to handle enabling/disabling our 'Select' button} var itemType: integer; itemRect: rect; trackResult: integer; mouseLoc: point; cntrlHndl, itemHndl: Controlhandle; oldPenState: PenState; { current pen settings } begin getDirDlgFilter := false; { We only use the updateEvt and so pass everything on to the std. filter} case theEvent.what of updateEvt: begin { mark the OPEN button as default by drawing a round rect around it } GetPenState(oldPenState); { remember the current pen settings } GetDItem(theDialog, getOpen, itemType, handle(itemHndl), itemRect); InsetRect(itemRect, -4, -4); Pensize(3, 3); FrameRoundRect(itemRect, 16, 16); SetPenState(oldPenState); { While we are diddling around, we might as well draw the amount of free space } drawFreeSpace(theDialog); { Disable the "Select" button when we are not highlighting any directories} GetDItem(theDialog, integerPtr(kApplScratch)^ + 1, itemType, handle(cntrlHndl), itemRect); GetDItem(theDialog, getOpen, itemType, handle(itemHndl), itemRect); if itemHndl^^.contrlHilite = 255 then HiliteControl(cntrlHndl, 255) { If the Open button is enabled, then enable the Select button} else HiliteControl(cntrlHndl, 0); { Otherwise disable the Select button} end; end; {case} end; {myDlgFilter} procedure SFGetDirectory (pt: point; Prompt: str255; var reply: SFReply); { The main routine!} var typeList: SFTypeList; promptHndl: handle; errorCode: OSErr; savedApplScratch: LongInt; oldPort: GrafPtr; begin { First we need to make sure the prompt is of even length} if prompt = '' then prompt := 'Hilite a directory and click "Select"'; if length(prompt) > 240 then prompt := copy(prompt, 1, 240) else if odd(length(prompt)) then prompt := concat(prompt, ' '); { Now we need to save the handle to the prompt where our Dialog Hook routine can find it} errorCode := ptrToHand(@prompt[1], promptHndl, length(prompt)); BlockMove(POINTER(kApplScratch), @savedApplScratch, 4); { save the appl scratch } BlockMove(@promptHndl, POINTER(kApplScratch), 4); { shove our prompt in } typeList[0] := '????'; GetPort(oldPort); { Save anything that we might change} SFPGetFile(pt, '', @getDirFileFilter, 1, TypeList, @getDirDLGHook, reply, getDlgID, @getDirDlgFilter); SetPort(oldPort); { and then restore it} BlockMove(@savedApplScratch, POINTER(kApplScratch), 4); { restore the contents of ApplScratch!!!!! } end; procedure FolderName (paramPtr: XCMDPtr); const DITLSizeDiff = 30; { Room needed for the prompt} var reply: SFReply; pathName: str255; prompt: str255; dlogHndl: DialogTHndl; tempRect: rect; thePt: point; err: OSErr; begin { First check to see if the user requested syntax or copyright information} { If they did, we exit the XFCN. The subroutine takes care of returning the proper string} if askedForHelp(paramPtr, 'FolderPath()', 'v1.1, ©1989, 1990 Apple Computer, Inc. by Anup Murarka & Eric Carlson') then exit(FolderName); { Parse the prompt out of the parameter list} if paramPtr^.paramCount > 0 then ZeroToPas(paramPtr, paramPtr^.params[1]^, prompt) else prompt := ''; { do the calculations to center it in the HC window } dlogHndl := DialogTHndl(GetResource('DLOG', getDlgID)); if dlogHndl <> nil then with dlogHndl^^.boundsRect do SetRect(tempRect, left, top, right, bottom + DITLSizeDiff) else SetRect(tempRect, 0, 0, 200, 348); thePt := CenterInHCWindow(paramPtr, tempRect); SFGetDirectory(thePt, Prompt, reply); { All of the real work is done by this routine in customSF.p} if reply.good then { If a directory was selected, return the pathname} begin err := PathNameFromDirID(longint(reply.fType), reply.vRefNum, pathName); if err = noErr then paramPtr^.returnValue := PasToZero(paramPtr, pathName); end; end; end.